home *** CD-ROM | disk | FTP | other *** search
/ Macademic for Students & Teachers / Macademic for Students and Teachers (Quantum Leap)(1992).iso / Fun & Games / TellTime / TellTime.src < prev    next >
Encoding:
Text File  |  1985-12-08  |  6.4 KB  |  326 lines  |  [TEXT/RCMP]
  1. program TellTime;
  2. Link  __IO, __Uniform ,__Extendio, __Strings, __Quickdraw,
  3.       __Sane, __saneio, __Printlib :;
  4. Var  
  5.      
  6.      len,i,r:integer;
  7.      irect,digrect:block[8];
  8.      irectptr,digrptr:ptrw;
  9.      x,y:integer;
  10.      height,width,size:integer;
  11.      xminhand,yminhand,xhrhand,yhrhand,handtype:integer;
  12.      xhr,yhr,xmin,ymin:integer;
  13.      xminold,yminold,xhrold,yhrold:integer;
  14.      arctan,c15708,c47116,c62832:float;
  15.      dighour,digmin:integer;
  16.  
  17. procedure _INIT();
  18.  
  19. begin
  20.   setorigin(0,0);
  21.   digrptr:=digrect;
  22.   digrptr^:=90;
  23.   digrptr:=digrptr+2;digrptr^:=300;
  24.   digrptr:=digrptr+2;digrptr^:=150;
  25.   digrptr:=digrptr+2;digrptr^:=490;
  26.   i:=0;
  27.   xminhand:=0;
  28.   xhrhand:=0;
  29.   yminhand:=0;
  30.   yhrhand:=0;
  31.   handtype:=1;
  32.   xminold:=130;
  33.   yminold:=130;
  34.   xhrold:=130;
  35.   yhrold:=130;
  36.   dighour:=0;
  37.   digmin:=0;
  38.   iqfillf(15708,-4,c15708);
  39.   iqfillf(3,0,c47116);
  40.   mulf(@c15708,@c47116);
  41.   iqfillf(4,0,c62832);
  42.   mulf(c15708,c62832);
  43.   ClockFace();
  44.   
  45. end;
  46.  
  47. Procedure _MAIN();
  48. begin
  49.    (* *)
  50. end;
  51.  
  52. Procedure _Mouse(x,y:integer);
  53. Var
  54.    xf,yf,rf:float;
  55.    xi,yi:integer;
  56.    xr,yr,con:integer;
  57.    xsave,ysave,rconst:float;
  58.    rmin,rhr:float;
  59. begin
  60.    textsize(12);
  61.    moveto(300,10);
  62.    (* writeint(x);
  63.    writeint(y); *)
  64.    x:=x-130;
  65.    y:=y-130;
  66.    iqfillf(x,0,xf);
  67.    iqfillf(y,0,yf);
  68.    ftof(xf,xsave);
  69.    ftof(yf,ysave);
  70.    (* compute arctan *)
  71.    ftof(@ysave,@arctan);
  72.    if x=0
  73.    then
  74.        begin
  75.             iqfillf(15708,-4,arctan);
  76.        end
  77.    else
  78.        begin
  79.             divf(@xsave,@arctan);
  80.             atanf(@arctan);
  81.        end;
  82.    (* moveto(280,80);
  83.    writef(arctan); *)
  84.    if x<0
  85.    then
  86.        begin
  87.             addf(@c47116,@arctan);
  88.        end
  89.    else
  90.        begin
  91.             addf(@c15708,@arctan);
  92.    end;
  93.    (* moveto(280,100);
  94.    writef(arctan); *)
  95.    (* end computation *)
  96.    mulf(@xf,@xf);
  97.    mulf(@yf,@yf);
  98.    addf(@yf,@xf);
  99.    iqfillf(0,0,rf);
  100.    addf(@xf,@rf);
  101.    sqrtf(@rf);
  102.    ftoi(@rf,@r);
  103.    moveto(300,20);
  104.    (* writeint(r); *)
  105.    (* xr yr are coordinates of normalized r *)
  106.    itof(60,rconst);
  107.    
  108.    ftof(xsave,xf);
  109.    mulf(@rconst,@xf);
  110.    divf(@rf,@xf);
  111.    ftoi(@xf,@xi);
  112.    
  113.    (* moveto(300,30);
  114.    writeint(xi); *)
  115.    ftof(ysave,yf);
  116.    mulf(@rconst,@yf);
  117.    divf(@rf,@yf);
  118.    ftoi(@yf,@yi);
  119.    (* writeint(yi); *)
  120.    itof(45,rhr);
  121.    ftof(xsave,xf);
  122.    mulf(@rhr,@xf);
  123.    divf(@rf,@xf);
  124.    ftoi(@xf,@xhr);
  125.    moveto(300,40);
  126.    (* writeint(xhr); *)
  127.    ftof(ysave,yf);
  128.    mulf(@rhr,@yf);
  129.    divf(@rf,@yf);
  130.    ftoi(@yf,@yhr);
  131.    (* writeint(yhr); *)
  132.     itof(75,rmin);
  133.    ftof(xsave,xf);
  134.    mulf(@rmin,@xf);
  135.    divf(@rf,@xf);
  136.    ftoi(@xf,@xmin);
  137.    (* moveto(300,50);
  138.    writeint(xmin); *)
  139.    ftof(ysave,yf);
  140.    mulf(@rmin,@yf);
  141.    divf(@rf,@yf);
  142.    ftoi(@yf,@ymin);
  143.    (* writeint(ymin); *)
  144.    
  145.    if  handtype=0
  146.    then
  147.        begin
  148.        hourhand();
  149.        getimeh();
  150.        end
  151.    else
  152.        begin
  153.        minhand();
  154.        getimem();
  155.    end;
  156.   (*  moveto(300,120);writeint(dighour);writeint(digmin); *)
  157.    digital();
  158. end;
  159. procedure hourhand();
  160. var newx,newy:integer;
  161. begin
  162.    moveto(300,10);
  163.    writestring("Hour Hand     ");
  164.    handtype:=1;
  165.    pensize(5,5);
  166.    erasehr();
  167.    moveto(130,130);
  168.    newx:=xhr+130;
  169.    newy:=yhr+130;
  170.    lineto(newx,newy);
  171.    xhrold:=newx;
  172.    yhrold:=newy;
  173. end;
  174. procedure erasehr();
  175. begin
  176.    moveto(130,130);
  177.    penmode(11);
  178.    lineto(xhrold,yhrold);
  179.    penmode(8);
  180.    pensize(3,3);
  181.    moveto(130,130);
  182.    lineto(xminold,yminold);
  183.    pensize(5,5);
  184. end;
  185. procedure minhand();
  186. var   newx,newy:integer;
  187. begin
  188.    moveto(300,10);
  189.    writestring("Minute hand");
  190.    handtype:=0;
  191.    pensize(3,3);
  192.    erasemin();
  193.    moveto(130,130);
  194.    newx:=xmin+130;
  195.    newy:=ymin+130;
  196.    lineto(newx,newy);
  197.    xminold:=newx;
  198.    yminold:=newy;
  199. end;
  200. procedure erasemin();
  201. begin
  202.    moveto(130,130);
  203.    penmode(11);
  204.    lineto(xminold,yminold);
  205.    penmode(8);
  206.    pensize(5,5);
  207.    moveto(130,130);
  208.    lineto(xhrold,yhrold);
  209.    pensize(3,3);
  210. end;
  211.    
  212. Procedure Tickmark();
  213. Var  h1,v1,h2,v2:integer;
  214. Begin
  215.    h1:=110;v1:=0;  h2:=120;v2:=0;  drawtick(h1,v1,h2,v2);
  216.    h1:=55; v1:=95; h2:=60; v2:=104;drawtick(h1,v1,h2,v2);
  217.    h1:=95; v1:=55; h2:=104;v2:=60; drawtick(h1,v1,h2,v2);
  218.    h1:=0;  v1:=110;h2:=0;  v2:=120;drawtick(h1,v1,h2,v2);
  219.    pensize(1,1);
  220.    (* h1:=110;v1:=11;h2:=119;v2:=12;drawtick(h1,v1,h2,v2); *)
  221. End;
  222. Procedure drawtick(h1,v1,h2,v2:integer);
  223.    Var ha,va,hb,vb:integer;
  224. Begin
  225.    ha:=h1+130;va:=130-v1;hb:=h2+130;vb:=130-v2;
  226.    moveto(ha,va);
  227.    lineto(hb,vb);    
  228.    ha:=130-h1;
  229.    hb:=130-h2;
  230.    moveto(ha,va);
  231.    lineto(hb,vb);
  232.    va:=130+v1;
  233.    vb:=130+v2;
  234.    moveto(ha,va);
  235.    lineto(hb,vb);
  236.    ha:=130+h1;
  237.    hb:=130+h2;
  238.    moveto(ha,va);
  239.    lineto(hb,vb);
  240.    
  241. End;
  242. Procedure digital();
  243. Var  hrstr,minstr,timestr,tempstr:block[100];
  244.      longhr,longmin:longint;
  245.      colonptr,zeroptr:ptrb;
  246. Begin
  247.    timestring();
  248.    moveto(260,200);
  249.    textsize(36);
  250.    eraserect(@digrect);
  251.    moveto(320,140);
  252.    longhr:=dighour;
  253.    numtostr(longhr,hrstr);
  254.    colonptr:=":";
  255.    strncat(@hrstr,colonptr,2);
  256.    longmin:=digmin;
  257.    numtostr(longmin,minstr);
  258.    if digmin<10 
  259.    then
  260.        Begin
  261.             zeroptr:="0";
  262.             strcpy(@tempstr,@minstr);
  263.             strcpy(@minstr,zeroptr);
  264.             strncat(@minstr,@tempstr,4);
  265.        End;
  266.    strncat(@hrstr,@minstr,4);
  267.    writestring(@hrstr);
  268.    textsize(12);
  269. End;
  270. Procedure getimeh();
  271. Var  ratio,fhour,fmin:float;
  272. Begin
  273.    ftof(@arctan,@ratio);
  274.    divf(@c62832,@ratio);
  275.    (* moveto(280,120);
  276.    writef(ratio); *)
  277.    itof(12,fhour);
  278.    mulf(@ratio,@fhour);
  279.    trncintf(@fhour);
  280.    (* moveto(280,140);
  281.    writef(fhour); *)
  282.    ftoi(@fhour,@dighour);
  283.    if  dighour=0 then dighour:=12;
  284. End;
  285. Procedure getimem();
  286. Var  ratio,fhour,fmin:float;
  287. Begin
  288.    ftof(@arctan,@ratio);
  289.    divf(@c62832,@ratio);
  290.    itof(60,fmin);
  291.    mulf(@ratio,@fmin);
  292.    trncintf(@fmin);
  293.    ftoi(@fmin,@digmin);
  294. End;
  295. Procedure timestring();
  296. Begin
  297. End;
  298.     
  299. Procedure ClockFace();
  300. begin
  301.   irectptr:=irect;
  302.   irectptr^:=10;
  303.   irectptr:=irectptr+2;
  304.   irectptr^:=10;
  305.   irectptr:=irectptr+2;
  306.   irectptr^:=250;
  307.   irectptr:=irectptr+2;
  308.   irectptr^:=250;
  309.   pensize(2,2);
  310.   frameoval(@irect);
  311.   size:=18; textsize(size);
  312.   moveto(118,36); writestring("12");
  313.   moveto(125,235); writestring("6");
  314.   moveto(227,137); writestring("3");
  315.   moveto(24,138); writestring("9");
  316.   moveto(173,52);writestring("1");
  317.   moveto(74,57);writestring("11");
  318.   moveto(75,218);writestring("7");
  319.   moveto(171,219);writestring("5");
  320.   moveto(203,86);writestring("2");
  321.   moveto(42,86);writestring("10");
  322.   moveto(42,188);writestring("8");
  323.   moveto(207,187);writestring("4");
  324.   Tickmark();
  325.   
  326. end;